home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN2.LZH / PARSE.FOR < prev    next >
Encoding:
Text File  |  1988-02-08  |  3.3 KB  |  128 lines
  1.       SUBROUTINE PARSE ( WORK, LW, TOKE, NTOKE, ERR )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **           PARSE           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          PARSER
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CALIF   94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          PARSE THE STRING INTO AN ARRAY OF TOKENS.
  23. C*          NOTE: THE ONLY VALID SYMBOLS ARE -
  24. C*                   UNITS,   EXPONENTS,   '*',   '^',  '/',  '(',  AND  ')'
  25. C*
  26. C*     METHODOLOGY :
  27. C*          NA
  28. C*
  29. C*     INPUT ARGUMENTS :
  30. C*          WORK  - THE STRING TO BE PARSED
  31. C*
  32. C*     OUTPUT ARGUMENTS :
  33. C*          TOKE  - THE ARRAY OF TOKENS
  34. C*          NTOKE - THE NUMBER OF TOKENS FOUND
  35. C*          ERR   - SET TRUE IF AN ERROR IS UNCOVERED
  36. C*
  37. C*     INTERNAL WORK AREAS :
  38. C*          NONE
  39. C*
  40. C*     COMMON BLOCKS :
  41. C*          NONE
  42. C*
  43. C*     FILE REFERENCES :
  44. C*          NONE
  45. C*
  46. C*     SUBPROGRAM REFERENCES :
  47. C*          LENGTH
  48. C*
  49. C*     ERROR PROCESSING :
  50. C*          CHECKS FOR INVALID CHARACTERS.
  51. C*          DISALLOWS EXPONENTS GREATER THAN 99.
  52. C*
  53. C*     TRANSPORTABILITY LIMITATIONS :
  54. C*          NONE
  55. C*
  56. C*     ASSUMPTIONS AND RESTRICTIONS :
  57. C*          NONE
  58. C*
  59. C*     LANGUAGE AND COMPILER :
  60. C*          ANSI FORTRAN 77
  61. C*
  62. C*     VERSION AND DATE :
  63. C*          VERSION I.0      7-FEB-85
  64. C*
  65. C*     CHANGE HISTORY :
  66. C*           7-FEB-85    INITIAL VERSION
  67. C*
  68. C***********************************************************************
  69. C*
  70.       CHARACTER *(*) WORK
  71.       CHARACTER *6 TOKE(1)
  72.       LOGICAL ERR
  73. C
  74.       I     = 1
  75.       NTOKE = 0
  76. C
  77. C --- ALL UNITS BEGIN WITH A CHARACTER
  78. C
  79. 100   IF ((WORK(I:I) .GE. 'A') .AND. (WORK(I:I) .LE. 'Z')) THEN
  80.          NTOKE = NTOKE + 1
  81.          INT = 1
  82.          TOKE(NTOKE) = ' '
  83. 110      IF (INT .LE. 6) THEN
  84.             TOKE(NTOKE)(INT:INT) = WORK(I:I)
  85.             INT = INT + 1
  86.          ENDIF
  87.          I = I + 1
  88.          IF (I .GT. LW) GO TO 1000
  89.          IF ((WORK(I:I) .GE. 'A') .AND. (WORK(I:I) .LE. 'Z')) GO TO 110
  90. C
  91. C --- NUMBERS USED AS EXPONENTS
  92. C
  93.       ELSE IF ((WORK(I:I) .GE. '0') .AND. (WORK(I:I) .LE. '9')) THEN
  94.          NTOKE = NTOKE + 1
  95.          INT   = 1
  96.          TOKE(NTOKE) = ' '
  97. 210      TOKE(NTOKE)(INT:INT) = WORK(I:I)
  98.          INT   = INT + 1
  99.          I     = I + 1
  100.          IF (I .GT. LW) GO TO 1000
  101.          IF ((WORK(I:I) .GE. '0') .AND. (WORK(I:I) .LE. '9')) GO TO 210
  102.          IF (INT .GT. 2) THEN
  103.             ERR = .TRUE.
  104.             RETURN
  105.          ENDIF
  106. C
  107. C --- OPERATORS ARE   (  )  *  /  ^
  108. C
  109.       ELSE IF ((WORK(I:I) .EQ. '(') .OR. (WORK(I:I) .EQ. ')') .OR.
  110.      $         (WORK(I:I) .EQ. '*') .OR. (WORK(I:I) .EQ. '/') .OR.
  111.      $         (WORK(I:I) .EQ. '^')) THEN
  112.          NTOKE = NTOKE + 1
  113.          TOKE(NTOKE) = WORK(I:I)
  114.          I = I + 1
  115. C
  116. C --- NO OTHER CHARACTERS ARE VALID
  117. C
  118.       ELSE
  119.          ERR = .TRUE.
  120.          RETURN
  121.       ENDIF
  122.       IF (I .LE. LW) GO TO 100
  123. 1000  RETURN
  124.       END
  125. C
  126. C---END PARSE
  127. C
  128.